home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
PGM_TOOL
/
PREVIEW
/
CLP2DLFI
/
DL2.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-10-29
|
16KB
|
489 lines
Unit wdl2;
Interface
Uses Classes, SysUtils, DBFserver, CommonCode, wPreview;
const
Max=200;
type
oFldpas=Class(TObject)
Private
function strsz(posit:integer):string;
Public
procedure dbf2pas(InDir,aDBFfile:string);
End;
Implementation
uses NuDelphi;
procedure oFldpas.dbf2pas(InDir,aDBFfile:string);
var ff,iii,bb,dd,pp,mm:array [1..Max] of integer;
ccnt:array [1..8] of integer;
cc:array [1..8,1..Max] of integer;
fcnt,icnt,bcnt,dcnt,mcnt,pcnt,filecnt:integer;
ii,jj,kk,zz,indent:integer;
tt,tt2,ott:string;
flist:tstringlist;
flds:DBFstruct;
outlines:tstringlist;
tDB:oDB;
begin
tDB:=nil;
indent:=2;
flds:=DBFstruct.create;
outlines:=tstringlist.create;
outlines.clear;
if Not empty(aDBFfile) then begin
dbUse(tDB,InDir+'\'+noext(aDBFfile) );
tDB.GetDBFStruct(flds);
dbClose(tDB);
with flds do begin
if fcount>0 then begin
tt:=upper(noext(aDBFfile));
ott:='o'+Copy(tt,1,1)+Copy(lower(tt),2,20);
tt2:='a'+Copy(tt,1,1)+Copy(lower(tt),2,20);
for ii:=1 to Max do begin
ff[ii]:=0;
iii[ii]:=0;
bb[ii]:=0;
dd[ii]:=0;
pp[ii]:=0;
for jj:=1 to 8 do cc[jj][ii]:=0;
ccnt[ii]:=0;
End;
fcnt:=0;
icnt:=0;
bcnt:=0;
mcnt:=0;
dcnt:=0;
pcnt:=0;
{ go through fields and fill arrays with position numbers }
for ii:=1 to fcount do begin
fname[ii]:=lower(fname[ii]);
{ cc[] 1<=10, 2<=20,3<=30,4<=40,5<=60,6<=80,7<=120;8<all else }
if ftype[ii]='C' then begin
if fwidth[ii]>255 then begin { must use pchar }
pcnt:=pcnt+1;
pp[pcnt]:=ii;
End Else Begin
jj:=8;
if fwidth[ii]<=120 then begin
jj:=7;
End;
if fwidth[ii]<=80 then begin
jj:=6;
End;
if fwidth[ii]<=60 then begin
jj:=5;
End;
if fwidth[ii]<=40 then begin
jj:=4;
End;
if fwidth[ii]<=30 then begin
jj:=3;
End;
if fwidth[ii]<=20 then begin
jj:=2;
End;
if fwidth[ii]<=10 then begin
jj:=1;
End;
ccnt[jj]:=ccnt[jj]+1;
cc[jj,ccnt[jj]]:=ii;
End;
End Else
if ftype[ii]='N' then begin
{ if fwidth[ii]<7 }
{ if fdecs[ii]>0 }
{ fcnt:=fcnt+1 }
{ ff[fcnt]:=ii }
{ else }
{ icnt:=icnt+1 }
{ iii[icnt]:=ii }
{ endif }
{ else }
fcnt:=fcnt+1;
ff[fcnt]:=ii;
{ endif }
End Else
if ftype[ii]='L' then begin
bcnt:=bcnt+1;
bb[bcnt]:=ii;
End Else
if ftype[ii]='D' then begin
dcnt:=dcnt+1;
dd[dcnt]:=ii;
End Else
if ftype[ii]='M' then begin
mcnt:=mcnt+1;
mm[mcnt]:=ii;
End Else Begin;
OKbox('Error: Field '+fname[ii]+' Type '+
ftype[ii]+' unknown');
End;
End;
outlines.add(space(indent)+ott+'=Class(TObject)');
outlines.add(space(indent)+'Private');
outlines.add(space(indent)+' '+tt2+':oDB;');
outlines.add(space(indent)+'Public');
outlines.add(space(indent)+' { variable declarations }');
outlines.add(space(indent)+' FromRecNo:longint;');
outlines.add(space(indent)+' Locked:boolean;');
outlines.add('');
for ii:=1 to 8 do begin
if ccnt[ii]>0 then begin
tt:=' ';
jj:=0;
for kk:=1 to ccnt[ii] do begin
if not empty(tt) then begin
tt:=tt+','+fname[cc[ii,kk]];
End Else Begin
tt:=tt+fname[cc[ii,kk]];
End;
jj:=jj+1;
if jj>5 then begin
outlines.add(space(indent)+tt+strsz(ii));
tt:=' ';
jj:=0;
End;
End;
if Not empty(tt) then begin
outlines.add(space(indent)+tt+strsz(ii));
jj:=0;
End;
End;
End;
if fcnt>0 then begin
tt:=' ';
jj:=0;
for kk:=1 to fcnt do begin
if not empty(tt) then begin
tt:=tt+','+fname[ff[kk]];
End Else Begin
tt:=tt+fname[ff[kk]];
End;
jj:=jj+1;
if jj>5 then begin
outlines.add(space(indent)+tt+':Double;');
tt:=' ';
jj:=0;
End;
End;
if Not empty(tt) then begin
outlines.add(space(indent)+tt+':Double;');
End;
End;
if icnt>0 then begin
tt:=' ';
jj:=0;
for kk:=1 to icnt do begin
if not empty(tt) then begin
tt:=tt+','+fname[iii[kk]];
End Else Begin
tt:=tt+fname[iii[kk]];
End;
jj:=jj+1;
if jj>5 then begin
outlines.add(space(indent)+tt+':Integer;');
tt:=' ';
jj:=0;
End;
End;
if Not empty(tt) then begin
outlines.add(space(indent)+tt+':Integer;');
End;
End;
if dcnt>0 then begin
tt:=' ';
jj:=0;
for kk:=1 to dcnt do begin
if not empty(tt) then begin
tt:=tt+','+fname[dd[kk]];
End Else Begin
tt:=tt+fname[dd[kk]];
End;
jj:=jj+1;
if jj>5 then begin
outlines.add(space(indent)+tt+':Longint;');
tt:=' ';
jj:=0;
End;
End;
if Not empty(tt) then begin
outlines.add(space(indent)+tt+':Longint;');
End;
End;
if bcnt>0 then begin
tt:=' ';
jj:=0;
for kk:=1 to bcnt do begin
if not empty(tt) then begin
tt:=tt+','+fname[bb[kk]];
End Else Begin
tt:=tt+fname[bb[kk]];
End;
jj:=jj+1;
if jj>5 then begin
outlines.add(space(indent)+tt+':Boolean;');
tt:=' ';
jj:=0;
End;
End;
if Not empty(tt) then begin
outlines.add(space(indent)+tt+':Boolean;');
End;
End;
if mcnt>0 then begin
tt:=' ';
jj:=0;
for kk:=1 to mcnt do begin
if not empty(tt) then begin
tt:=tt+','+fname[mm[kk]];
End Else Begin
tt:=tt+fname[mm[kk]];
End;
jj:=jj+1;
if jj>5 then begin
outlines.add(space(indent)+tt+':Pchar; { Memo }');
tt:=' ';
jj:=0;
End;
End;
if Not empty(tt) then begin
outlines.add(space(indent)+tt+':Pchar; { Memo }');
End;
End;
if pcnt>0 then begin
tt:=' ';
jj:=0;
for kk:=1 to pcnt do begin
if not empty(tt) then begin
tt:=tt+','+fname[pp[kk]];
End Else Begin
tt:=tt+fname[pp[kk]];
End;
jj:=jj+1;
if jj>5 then begin
outlines.add(space(indent)+tt+':Pchar; { Char Field Width>255 }');
tt:=' ';
jj:=0;
End;
End;
if Not empty(tt) then begin
outlines.add(space(indent)+tt+':Pchar; { Char Field Width>255 }');
End;
End;
outlines.add(space(indent)+' procedure Init(aDBvar:oDB);');
outlines.add(space(indent)+' function Load(WithLock:Boolean):boolean;');
outlines.add(space(indent)+' procedure Save;');
outlines.add(space(indent)+'end;');
outlines.add('');
outlines.savetofile(Indir+'\'+noext(aDBFfile)+'.int');
outlines.clear;
outlines.add(space(indent)+'procedure '+ott+'.Init(aDBvar:oDB);');
outlines.add(space(indent)+'begin');
outlines.add(space(indent)+' { init vars }');
outlines.add(space(indent)+' if dbIsOpen(aDBvar) then '+tt2+':=aDBvar;');
outlines.add(space(indent)+' FromRecno:=0;');
outlines.add(space(indent)+' Locked:=false;');
for ii:=1 to 8 do begin
if ccnt[ii]>0 then begin
for jj:=1 to ccnt[ii] do begin
tt:=fname[cc[ii,jj]];
outlines.add(space(indent)+' '+tt+':='''';');
End;
End;
End;
if fcnt>0 then begin
for jj:=1 to fcnt do begin
tt:=fname[ff[jj]];
outlines.add(space(indent)+' '+tt+':=0;');
End;
End;
if icnt>0 then begin
for jj:=1 to icnt do begin
tt:=fname[iii[jj]];
outlines.add(space(indent)+' '+tt+':=0;');
End;
End;
if dcnt>0 then begin
for jj:=1 to dcnt do begin
tt:=fname[dd[jj]];
outlines.add(space(indent)+' '+tt+':=0;');
End;
End;
if bcnt>0 then begin
for jj:=1 to bcnt do begin
tt:=fname[bb[jj]];
outlines.add(space(indent)+' '+tt+':=false;');
End;
End;
if pcnt>0 then begin
for jj:=1 to pcnt do begin
tt:=fname[pp[jj]];
outlines.add(space(indent)+' '+tt+':=StrAlloc(MaxMemoSize); { Field: '+
ltrim(str2(fwidth[pp[jj]],5))+' chars }');
End;
End;
outlines.add(space(indent)+'end;');
outlines.add('');
outlines.add(space(indent)+'function '+ott+'.Load(WithLock:Boolean):Boolean;');
outlines.add(space(indent)+'begin');
outlines.add(space(indent)+' Init(Nil);');
outlines.add(space(indent)+' Result:=true;');
outlines.add(space(indent)+' FromRecNo:='+tt2+'.RecNo;');
outlines.add(space(indent)+' if WithLock then begin');
outlines.add(space(indent)+' Result:='+tt2+'.aLock;');
outlines.add(space(indent)+' if not Result then Exit else Locked:=true;');
outlines.add(space(indent)+' end;');
outlines.add(space(indent)+' { set vars from fields }');
for ii:=1 to 8 do begin
if ccnt[ii]>0 then begin
for jj:=1 to ccnt[ii] do begin
tt:=fname[cc[ii,jj]];
outlines.add(space(indent)+' '+tt+':='+tt2+'.st('''+tt+''');');
End;
End;
End;
if fcnt>0 then begin
for jj:=1 to fcnt do begin
tt:=fname[ff[jj]];
outlines.add(space(indent)+' '+tt+':='+tt2+'.f('''+tt+''');');
End;
End;
if icnt>0 then begin
for jj:=1 to icnt do begin
tt:=fname[iii[jj]];
outlines.add(space(indent)+' '+tt+':='+tt2+'.i('''+tt+''');');
End;
End;
if dcnt>0 then begin
for jj:=1 to dcnt do begin
tt:=fname[dd[jj]];
outlines.add(space(indent)+' '+tt+':='+tt2+'.d('''+tt+''');');
End;
End;
if bcnt>0 then begin
for jj:=1 to bcnt do begin
tt:=fname[bb[jj]];
outlines.add(space(indent)+' '+tt+':='+tt2+'.b('''+tt+''');');
End;
End;
if pcnt>0 then begin
for jj:=1 to pcnt do begin
tt:=fname[pp[jj]];
outlines.add(space(indent)+' '+tt2+'.longs('''+tt+''','+tt+');');
End;
End;
if mcnt>0 then begin
for jj:=1 to mcnt do begin
tt:=fname[mm[jj]];
outlines.add(space(indent)+' '+tt2+'.m('''+tt+''','+tt+');');
End;
End;
outlines.add(space(indent)+'end;');
outlines.add('');
outlines.add(space(indent)+'procedure '+ott+'.Save;');
outlines.add(space(indent)+'begin');
outlines.add(space(indent)+' if not Locked then begin');
outlines.add(space(indent)+' OKbox('+tt2+'.Alias+'+
''' Error: Tried to save to an unlocked record'');');
outlines.add(space(indent)+' Exit;');
outlines.add(space(indent)+' end;');
outlines.add(space(indent)+' if FromRecNo>0 then '+tt2+'.Go(FromRecNo);');
outlines.add(space(indent)+' { set fields from vars }');
for ii:=1 to 8 do begin
if ccnt[ii]>0 then begin
for jj:=1 to ccnt[ii] do begin
tt:=fname[cc[ii,jj]];
outlines.add(space(indent)+' '+tt2+'.ss('''+tt+''','+tt+');');
End;
End;
End;
if fcnt>0 then begin
for jj:=1 to fcnt do begin
tt:=fname[ff[jj]];
outlines.add(space(indent)+' '+tt2+'.ff('''+tt+''','+tt+');');
End;
End;
if icnt>0 then begin
for jj:=1 to icnt do begin
tt:=fname[iii[jj]];
outlines.add(space(indent)+' '+tt2+'.ii('''+tt+''','+tt+');');
End;
End;
if dcnt>0 then begin
for jj:=1 to dcnt do begin
tt:=fname[dd[jj]];
outlines.add(space(indent)+' '+tt2+'.dd('''+tt+''','+tt+');');
End;
End;
if bcnt>0 then begin
for jj:=1 to bcnt do begin
tt:=fname[bb[jj]];
outlines.add(space(indent)+' '+tt2+'.bb('''+tt+''','+tt+');');
End;
End;
if pcnt>0 then begin
for jj:=1 to pcnt do begin
tt:=fname[pp[jj]];
outlines.add(space(indent)+' '+tt2+'.longss('''+tt+''','+tt+');');
End;
End;
if mcnt>0 then begin
for jj:=1 to mcnt do begin
tt:=fname[mm[jj]];
outlines.add(space(indent)+' '+tt2+'.mm('''+tt+''','+tt+');');
End;
End;
outlines.add(space(indent)+' '+tt2+'.Unlock;');
outlines.add(space(indent)+' Locked:=false;');
outlines.add(space(indent)+'end;');
outlines.add('');
if (pcnt>0) Or (mcnt>0) then begin
OKbox(upper(noext(aDBFfile))+
' Has Memo or Char>255, Requires Special Handling');
End;
outlines.savetofile(Indir+'\'+noext(aDBFfile)+'.imp');
End;
End;
End;
flds.free;
outlines.free;
End;
function oFldpas.strsz(posit:integer):string;
Begin
Result:='';
if posit=1 then begin
Result:=':String[10];';
End Else
if posit=2 then begin
Result:=':String[20];';
End Else
if posit=3 then begin
Result:=':String[30];';
End Else
if posit=4 then begin
Result:=':String[40];';
End Else
if posit=5 then begin
Result:=':String[60];';
End Else
if posit=6 then begin
Result:=':String[80];';
End Else
if posit=7 then begin
Result:=':String[120];';
End Else
if posit=8 then begin
Result:=':String;';
End;
End;
End.